#' Calculate the percentage of all counts that belong to a given set of features
#'
#' This function enables you to easily calculate the percentage of all the counts belonging to a
#' subset of the possible features for each cell. This is useful when trying to compute the percentage
#' of transcripts that map to mitochondrial genes for example. The calculation here is simply the
#' column sum of the matrix present in the counts slot for features belonging to the set divided by
#' the column sum for all features times 100.
#'
#' @param object A Seurat object
#' @param pattern A regex pattern to match features against
#' @param features A defined feature set. If features provided, will ignore the pattern matching
#' @param col.name Name in meta.data column to assign. If this is not null, returns a Seurat object
#' with the proportion of the feature set stored in metadata.
#' @param assay Assay to use
#'
#' @return Returns a vector with the proportion of the feature set or if md.name is set, returns a
#' Seurat object with the proportion of the feature set stored in metadata.
#' @importFrom Matrix colSums
#' @export
#' @concept utilities
#'
#' @examples
#' data("pbmc_small")
#' # Calculate the proportion of transcripts mapping to mitochondrial genes
#' # NOTE: The pattern provided works for human gene names. You may need to adjust depending on your
#' # system of interest
#' pbmc_small[["percent.mt"]] <- PercentageFeatureSet(object = pbmc_small, pattern = "^MT-")
#'
PercentageFeatureSet <- function(
  object,
  pattern = NULL,
  features = NULL,
  col.name = NULL,
  assay = NULL
) {
  # 如果 assay 没有传入，则设置默认值
  assay <- assay %||% DefaultAssay(object = object)

  # 如果 features 非空，且 pattern 非空，则提示：同时提供2者，忽略 正则
  if (!is.null(x = features) && !is.null(x = pattern)) {
    warning("Both pattern and features provided. Pattern is being ignored.")
  }

  # feature 如果提供了，就用；如果没提供，则使用正则获取 symbol
  features <- features %||% grep(pattern = pattern, x = rownames(x = object[[assay]]), value = TRUE)
  

  ########## 这一句干货的
  # 基因集占的百分比 = 分子 / 分母 * 100；
  # 分子： GetAssayData 获取 counts矩阵，按列求 指定基因的 counts和 per cell
  # 分母： 从 meta.data 获取 nCount_RNA 列，所有基因的 counts和 per cell
  percent.featureset <- colSums(x = GetAssayData(object = object, assay = assay, slot = "counts")[features, , drop = FALSE])/
    object[[paste0("nCount_", assay)]] * 100

  # 如果列名非空，加到 meta.data 上，只有一列，需要提供列名。并返回对象。
  if (!is.null(x = col.name)) {
    
    object <- AddMetaData(object = object, metadata = percent.featureset, col.name = col.name)
    return(object)
  }

  # 返回一列百分比
  return(percent.featureset)
}


# GetAssayData() 解析 5 3.4 部分。
# 它的核心句子就是 object@slotname 默认是c('data', 'scale.data', 'counts')的第一个。


# DefaultAssay() 函数，是一个S3泛型函数
#$ find .  | grep "R$" | xargs grep -n "DefaultAssay" --color=auto

# /seurat-object-4.0.4/R/generics.R:205:DefaultAssay <- function(object, ...) {



#' Default Assay
#'
#' Get and set the default assay
#'
#' @param object An object
#' @param ... Arguments passed to other methods
#'
#' @return \code{DefaultAssay}: The name of the default assay
#'
#' @rdname DefaultAssay
#' @export DefaultAssay
#'
#' @concept data-access
#'
DefaultAssay <- function(object, ...) {
  UseMethod(generic = 'DefaultAssay', object = object)
}

# 输入的是 Seurat 对象，所以应该找 DefaultAssay.Seurat 的实现
# seurat-object-4.0.4/R/seurat.R:1116:DefaultAssay.Seurat <- function(object, ...) {

#' @rdname DefaultAssay
#' @export
#' @method DefaultAssay Seurat
#'
#' @examples
#' # Get current default assay
#' DefaultAssay(object = pbmc_small)
#'
DefaultAssay.Seurat <- function(object, ...) {
  CheckDots(...)
  object <- UpdateSlots(object = object)
  return(slot(object = object, name = 'active.assay'))
}
# DefaultAssay 返回的就是 pbmc_small@active.assay #RNA

# 检查 ... 参数；
# 更新对象的slot
# 返回对象的 active.assay slot 内容，就是一个字符串。
#> str(pbmc_small@active.assay) #chr "RNA"













# CheckDots(...) 检查了什么？
#seurat-object-4.0.4/R/utils.R:612:CheckDots <- function(..., fxns = NULL) {


#' Check the Use of Dots
#'
#' Function to check the use of unused arguments passed to \code{...}; this
#' function is designed to be called from another function to see if an
#' argument passed to \code{...} remains unused and alert the user if so. #检查某个参数是否使用过了，如果用过了就提醒用户
#' Also accepts a vector of function or function names to see if \code{...} can be
#' used in a downstream function #也可以接收函数名字，来看...是否可以用于接下来的函数中。
#'
#' Behavior of \code{CheckDots} can be controlled by the following option(s):
#' \describe{
#'  \item{\dQuote{\code{Seurat.checkdots}}}{Control how to alert the presence
#'  of unused arguments in \code{...}; choose from
#'  \itemize{
#'   \item \dQuote{\code{warn}}: emit a warning (default)
#'   \item \dQuote{\code{error}}: throw an error
#'   \item \dQuote{\code{silent}}: no not alert the presence of unused
#'   arguments in \code{...}
#'  }
#'  }
#' }
#'
#' @param ... Arguments passed to a function that fall under \code{...}
#' @param fxns A list/vector of functions or function names
#'
#' @return Emits either an error or warning if an argument passed is unused;
#' invisibly returns \code{NULL}
#'
#' @importFrom utils isS3stdGeneric methods argsAnywhere isS3method
#'
#' @keywords internal
#'
#' @export
#'
#' @examples
#' \dontrun{
#' f <- function(x, ...) {
#'   CheckDots(...)
#'   return(x ^ 2)
#' }
#' f(x = 3, y = 9)
#' }
#'
CheckDots <- function(..., fxns = NULL) {
  args.names <- names(x = list(...)) #获取参数列表的名字

  # 如果参数长度是0，则返回空，不打印
  if (length(x = list(...)) == 0) {
    return(invisible(x = NULL))
  }

  # 查了一下，大多数调用都是没有第一个参数，也没有第二个参数，所以啥也没干就结束了。
  # 后面写的很复杂，没看太懂，大致注释了一下，以后碰到了再细看

  #如果名字含有NULL则报错
  if (is.null(x = args.names)) {
    stop("No named arguments passed")
  }


  #####################
  # 第二个参数是函数
  # 如果只有一个函数，则直接变list
  if (length(x = fxns) == 1) {
    fxns <- list(fxns)
  }
  # 对list循环，获取的是里面的值
  for (f in fxns) {
    # 如果不是 (字符串 or 函数）,报错
    if (!(is.character(x = f) || is.function(x = f))) {
      stop("CheckDots only works on characters or functions, not ", class(x = f))
    }
  }

  # sapply 第一个参数可以是函数或函数名
  fxn.args <- suppressWarnings(expr = sapply(
    X = fxns,
    FUN = function(x) { #x是 fxns 中的每一个元素( 函数名字符串 or 函数名)

      x <- tryCatch( #如果报错就执行 error 语句
        # 如果x是S3泛型函数，则获取全部函数名字，并转为字符串；如果不是，返回本身
        expr = if (isS3stdGeneric(f = x)) {
          as.character(x = methods(generic.function = x))
        } else {
          x
        },
        error = function(...) {
          return(x)
        }
      )

      # 如果x是(函数名)字符串，获取每个x的参数列表
      x <- if (is.character(x = x)) {
        sapply(X = x, FUN = argsAnywhere, simplify = FALSE, USE.NAMES = TRUE)
      } else if (length(x = x) <= 1) {
        list(x)
      }

      # 获取每个函数的参数列表
      return(sapply(
        X = x,
        FUN = function(f) {
          return(names(x = formals(fun = f)))
        },
        simplify = FALSE,
        USE.NAMES = TRUE
      ))

    },
    simplify = FALSE,
    USE.NAMES = TRUE
  ))
  # 解包list
  fxn.args <- unlist(x = fxn.args, recursive = FALSE)

  # 看每个参数列表是不是null
  fxn.null <- vapply(
    X = fxn.args,
    FUN = is.null,
    FUN.VALUE = logical(length = 1L)
  )


  # 如果参数列表全部都是null，且函数不是null，可能是没找到函数，报错。
  if (all(fxn.null) && !is.null(x = fxns)) {
    stop("None of the functions passed could be found", call. = FALSE)

    # 否则，如果存在 null，警告：有几个函数没找到
  } else if (any(fxn.null)) {
    warning(
      "The following functions passed could not be found: ",
      paste(names(x = which(x = fxn.null)), collapse = ', '),
      call. = FALSE,
      immediate. = TRUE
    )
    # 过滤：保留不是 null的元素 （参数列表）
    fxn.args <- Filter(f = Negate(f = is.null), x = fxn.args)
  }

  # 创建 vector
  dfxns <- vector(mode = 'logical', length = length(x = fxn.args))
  
  names(x = dfxns) <- names(x = fxn.args)
  
  # 是否有参数列表是...的？有一个就是T，没有就是F
  for (i in 1:length(x = fxn.args)) {
    dfxns[i] <- any(grepl(pattern = '...', x = fxn.args[[i]], fixed = TRUE))
  }

  # 如果有参数列表是...的
  if (any(dfxns)) {
    dfxns <- names(x = which(x = dfxns))
    if (any(nchar(x = dfxns) > 0)) {
      fx <- vapply(
        X = Filter(f = nchar, x = dfxns),
        FUN = function(x) {
          if (isS3method(method = x)) {
            x <- unlist(x = strsplit(x = x, split = '\\.'))
            x <- x[length(x = x) - 1L]
          }
          return(x)
        },
        FUN.VALUE = character(length = 1L)
      )

      message(
        "The following functions and any applicable methods accept the dots: ",
        paste(unique(x = fx), collapse = ', ')
      )
      
      if (any(nchar(x = dfxns) < 1)) {
        message(
          "In addition, there is/are ",
          length(x = Filter(f = Negate(f = nchar), x = dfxns)),
          " other function(s) that accept(s) the dots"
        )
      }
    } else {
      message("There is/are ", length(x = dfxns), 'function(s) that accept(s) the dots')
    }

  # 如果没有...的参数
  } else {
    unused <- Filter(
      f = function(x) {
        return(!x %in% unlist(x = fxn.args))
      },
      x = args.names
    )

    if (length(x = unused) > 0) {
      msg <- paste0(
        "The following arguments are not used: ",
        paste(unused, collapse = ', ')
      )
      switch(
        EXPR = getOption(x = "Seurat.checkdots", default = 'warn'),
        "warn" = warning(msg, call. = FALSE, immediate. = TRUE),
        "stop" = stop(msg),
        "silent" = NULL,
        stop("Invalid Seurat.checkdots option. Please choose one of warn, stop, silent")
      )
      # unused.hints <- sapply(X = unused, FUN = OldParamHints)
      # names(x = unused.hints) <- unused
      # unused.hints <- na.omit(object = unused.hints)
      # if (length(x = unused.hints) > 0) {
      #   message(
      #     "Suggested parameter: ",
      #     paste(unused.hints, "instead of", names(x = unused.hints), collapse = '; '),
      #     "\n"
      #   )
      # }
    }
  }
  return(invisible(x = NULL))
}











# UpdateSlots
#seurat-object-4.0.4/R/utils.R:976:UpdateSlots <- function(object) {


#' Update slots in an object
#'
#' @param object An object to update
#'
#' @return \code{object} with the latest slot definitions
#'
#' @importFrom methods slotNames slot
#'
#' @keywords internal 内部方法
#'
#' @noRd
#'
UpdateSlots <- function(object) {

  # 把S4对象变为键值对的 list
  object.list <- sapply(
    X = slotNames(x = object), #对 slotNames 进行循环
    FUN = function(x) {
      return(tryCatch(
        expr = slot(object = object, name = x), #获取该slot的值
        error = function(...) { #如果出错，则返回 NULL
          return(NULL)
        }
      ))
    },
    simplify = FALSE, #不使用简单输出
    USE.NAMES = TRUE #使用名字
  )

  # 过滤：只保留不为 NULL 的元素
  object.list <- Filter(f = Negate(f = is.null), x = object.list)

  # list的首位添加元素：类名
  object.list <- c('Class' = class(x = object)[1], object.list)

  # 新建对象，list to S4对象
  # 这相当于获取所有值，使用最新版类的定义，重新实例化一次
  object <- do.call(what = 'new', args = object.list)

  # 新对象 vs 老对象，如果有新增的slot，对该slot的名字进行循环
  for (x in setdiff(x = slotNames(x = object), y = names(x = object.list))) {
    # 获取新对象中该slot的值
    xobj <- slot(object = object, name = x)

    # 如果是vector， 且不是list， 且长度为0。 满足这3条的是个啥鬼东西？
    if (is.vector(x = xobj) && !is.list(x = xobj) && length(x = xobj) == 0) {
      # 则赋值给这个slot：一个长度为1的，类别为元素本身class的vector
      slot(object = object, name = x) <- vector(
        mode = class(x = xobj),
        length = 1L
      )
    }
  }
  return(object)
}
